home *** CD-ROM | disk | FTP | other *** search
/ PC Users 1998 June / Cd Pc Users 9.iso / prog / inst / rotfont / rotfont.exe / Rotated fonts.Frm (.txt) next >
Encoding:
Visual Basic Form  |  1997-12-19  |  3.7 KB  |  124 lines
  1. VERSION 4.00
  2. Begin VB.Form Form1 
  3.    Caption         =   "Form1"
  4.    ClientHeight    =   6975
  5.    ClientLeft      =   -30
  6.    ClientTop       =   1695
  7.    ClientWidth     =   8685
  8.    Height          =   7380
  9.    Left            =   -90
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   6975
  12.    ScaleWidth      =   8685
  13.    Top             =   1350
  14.    Width           =   8805
  15.    Begin VB.TextBox txtSize 
  16.       Height          =   285
  17.       Left            =   4680
  18.       TabIndex        =   4
  19.       Text            =   "12"
  20.       Top             =   120
  21.       Width           =   495
  22.    End
  23.    Begin VB.TextBox txtDegree 
  24.       Height          =   285
  25.       Left            =   2520
  26.       TabIndex        =   2
  27.       Text            =   "90"
  28.       Top             =   120
  29.       Width           =   615
  30.    End
  31.    Begin VB.CommandButton Command1 
  32.       Caption         =   "Write"
  33.       Height          =   375
  34.       Left            =   360
  35.       TabIndex        =   0
  36.       Top             =   120
  37.       Width           =   975
  38.    End
  39.    Begin VB.Label Label2 
  40.       Caption         =   "Size"
  41.       Height          =   255
  42.       Left            =   3480
  43.       TabIndex        =   3
  44.       Top             =   120
  45.       Width           =   975
  46.    End
  47.    Begin VB.Label Label1 
  48.       Caption         =   "Degrees"
  49.       Height          =   255
  50.       Left            =   1560
  51.       TabIndex        =   1
  52.       Top             =   120
  53.       Width           =   855
  54.    End
  55. Attribute VB_Name = "Form1"
  56. Attribute VB_Creatable = False
  57. Attribute VB_Exposed = False
  58. Option Explicit
  59. Private Type LOGFONT
  60.   lfHeight As Long
  61.   lfWidth As Long
  62.   lfEscapement As Long
  63.   lfOrientation As Long
  64.   lfWeight As Long
  65.   lfItalic As Byte
  66.   lfUnderline As Byte
  67.   lfStrikeOut As Byte
  68.   lfCharSet As Byte
  69.   lfOutPrecision As Byte
  70.   lfClipPrecision As Byte
  71.   lfQuality As Byte
  72.   lfPitchAndFamily As Byte
  73. ' lfFaceName(LF_FACESIZE) As Byte 'THIS WAS DEFINED IN API-CHANGES MY OWN
  74.   lfFacename As String * 33
  75. End Type
  76. Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
  77. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  78. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  79. Private Sub CheckVals()
  80.   Command1.Enabled = ((Val(txtDegree.Text) < 360) And Val(txtsize.Text) > 7)
  81. End Sub
  82. Private Sub FontStuff()
  83.   On Error GoTo GetOut
  84.   Dim F As LOGFONT, hPrevFont As Long, hFont As Long, FontName As String
  85.   Dim FONTSIZE As Integer
  86.   FONTSIZE = Val(txtsize.Text)
  87.   F.lfEscapement = 10 * Val(txtDegree.Text) 'rotation angle, in tenths
  88.   FontName = "Arial Black" + Chr$(0) 'null terminated
  89.   F.lfFacename = FontName
  90.   F.lfHeight = (FONTSIZE * -20) / Screen.TwipsPerPixelY
  91.   hFont = CreateFontIndirect(F)
  92.   hPrevFont = SelectObject(Me.hdc, hFont)
  93.   CurrentX = 3930
  94.   CurrentY = 3860
  95.   Print "Funny Font"
  96. '  Clean up, restore original font
  97.   hFont = SelectObject(Me.hdc, hPrevFont)
  98.   DeleteObject hFont
  99.   Exit Sub
  100. GetOut:
  101.   Exit Sub
  102. End Sub
  103. Private Sub Command1_Click()
  104.   Me.Cls
  105.   FontStuff
  106. End Sub
  107. Private Sub Form_Load()
  108. '**********************************************************
  109. 'This file passed trought:
  110. 'K.Driblinov prg page... tons of C & Vb sources, links to
  111. 'other prg sites!!
  112. 'http://www.geocities.com/SiliconValley/Lakes/7057/index.htm
  113. 'E-Mail: kdriblinov@hotmail.com
  114. '***********************************************************
  115. End Sub
  116. Private Sub txtDegree_Change()
  117.   If Not IsNumeric(txtDegree.Text) Then txtDegree.Text = "90"
  118.   CheckVals
  119. End Sub
  120. Private Sub txtsize_Change()
  121.   If Not IsNumeric(txtsize.Text) Then txtsize.Text = "18"
  122.   CheckVals
  123. End Sub
  124.